home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / encorsrc.lha / encore_sources / sys / vm_boot.t < prev    next >
Text File  |  1988-05-02  |  5KB  |  120 lines
  1. (herald vm_boot (env tsys))
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26. ;;;; System startup
  27.  
  28. ;;; This is where the startup sequence (GENESIS in e.g. aem68kernel)
  29. ;;; jumps; right into the eval-mungeables of this file.  We must
  30. ;;; not return - the kernel hasn't prepared for that possibility.
  31. ;;; All it has done at this point is set up the stack, heap memory,
  32. ;;; global constants, the root process, and the boot argument vector.
  33. ;;; *THE-INITIAL-MODULES* is defined by the linker.
  34.  
  35. ;;; Initialize the kernel
  36.  
  37. ;;; Unsuspended boot.  Assumes that evaluating top level forms will
  38. ;;; not blow out the initial area.  When a system is suspended *boot*
  39. ;;; is set to SUSPENDED-BOOT.  Note: *boot* must be defined and
  40. ;;; not lset or big_bang will not be able to jump to *boot*.  This
  41. ;;; is the only variable in the system with this constraint.
  42.  
  43. (define (*boot* root-process boot-args debug?)
  44.   ;; Grock the initial modules.
  45.   (ignore boot-args root-process)
  46.   (set (system-global slink/boot-area-base) (make-vector 0))
  47.   (set (system-global slink/initial-impure-base)
  48.        (vref *the-initial-modules* 0))
  49.   (let ((len (vector-length *the-initial-modules*)))
  50.     (do ((i 0 (fx+ i 1)))
  51.         ((fx>= i len))
  52.       (let ((unit (vref *the-initial-modules* i)))
  53.         (if debug? (print-module-name unit))
  54.         ;++ fix this when modules work, or maybe when adjusting units
  55.         (set (unit-env unit) tvm-env)
  56.         ((unit-top-level-forms unit))))
  57.     (if debug? (%vm-boot-write-tty '...Groked.))
  58.     (initialize-systems)
  59.     (top-level)))
  60.  
  61. (define (print-module-name unit)
  62.   (let ((id (car (unit-herald unit))))
  63.     (cond ((symbol? id)
  64.            (%vm-boot-write-tty id))
  65.           ((list? id)
  66.            (%vm-boot-write-tty (cadr id)))
  67.           (else
  68.            (%vm-boot-write-tty '*****uluz****)))))
  69.  
  70. ;*** The following procedure(s) is (are) in this file because they
  71. ;*** are only used when bootstrapping the VM.
  72.  
  73. ;;; Move the initial symbols into the symbol table.
  74.  
  75.  
  76. (define (initialize-symbol-table)
  77.   (let ((tlen (vector-length the-symbols))
  78.         (len  (vector-length *the-initial-symbols*)))
  79.     (do ((i 0 (fx+ i 1)))
  80.         ((fx>= i len))
  81.       (let* ((symbol (vref *the-initial-symbols* i))
  82.              (index  (fx-rem (symbol-hash symbol) tlen)))
  83.         (set (vref the-symbols index)
  84.              (cons symbol (vref the-symbols index)))))))
  85.  
  86. ;;; BOOTSTRAP-ENV is a global environment for use before LOCALES are available.
  87.  
  88. (define (bootstrap-env id local? create?)
  89.   (ignore local?)
  90.   (cond ((assq id *boot-env*)
  91.          => cdr)
  92.         (create?    
  93.          (let ((v (make-vcell id)))
  94.            (push *boot-env* (cons id v))
  95.            v))
  96.         (else nil)))
  97.  
  98. ;;; MAKE-BASE-ENVIRONMENT is used to build the T-IMPLEMENTATION-ENV
  99. ;;; which will replace the *z-repl-env*.  It cannot be called until
  100. ;;; environments are available.  Note: the *boot-env* can only
  101. ;;; contain symbols as identifiers.
  102.  
  103. (define (make-base-environment id)
  104.   (let ((table (make-symbol-table-with-size (length *boot-env*) id)))
  105.     (walk (lambda (entry) 
  106.             (set (table-entry table (car entry)) (cdr entry)))
  107.           *boot-env*)
  108.     (really-make-locale nil id table)))
  109.  
  110. ;;; BOOT-ADJUST-INITIAL-UNITS is used to set the herald and source
  111. ;;; filenames of the initial units.  It cannot be called until
  112. ;;; operations are enabled, adjust-unit-names, and filenames are
  113. ;;; available.
  114.  
  115. (define (boot-adjust-initial-units)
  116.   (table-walk (weak-table-table code-unit-table)
  117.               (lambda (code unit)
  118.                 (ignore code)
  119.                 (adjust-unit-names unit))))
  120.